HPAVC/HPAVC CD-ROM.iso/PRUS101.ZIP/FCHARS.PAS

Pascal/Delphi Source File | 1994-12-19 | 14KB | 413 lines

UNIT FCHARS; { FIDO unit to add Borland Pascal 7.0's Strings functions to
               prior versions }
 (***************************************************************************

        RELEASE 1.00 - as first contained in the file PRUS101.LZH
              by Sieghard Schicktanz, 2:2480/642.25, GERMANY

               --------------------------------------------
                organized for Fido's PASCAL related echoes
               --------------------------------------------

   08/02/1994 to --/--/---- by Sieghard Schicktanz, 2:2480/642.25, GERMANY


           As far as third party copyrights are not violated this
           source code is hereby placed to the public domain. Use
           it whatever way you want, but use AT YOUR OWN RISK.

           In case you should modify the source rather send your
           modifications to the unit's current organizer (see above for
           NM address) than to spread it on your own. This will help to
           keep the unit updated and grant a certain standard to all
           other users as well.

           The unit is currently still under work. So it might greatly
           benefit of your participation.

           Those who contributed to the following piece of source,
           listed in alphabethical order:
        ================================================================
           Andrew Eigus, Sieghard Schicktanz, ...
        ================================================================
           YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.

           Credits in your own programs are as welcome as unnecessary.

 ***************************************************************************)

{ $I FDEFINE.DEF}

INTERFACE

TYPE
  chArray = ARRAY [0..MaxInt] OF char;  { just a dummy definition }
  PChar = ^chArray;

FUNCTION null_string: PChar;
{ returns pointer to a string which is always empty }

FUNCTION Str2PChar (str: string): PChar;
{ alternate function for StrPCopy, both functions
  work the same way, except that Str2PChar does not
  expect the destination to be given as an argument. }

FUNCTION StrCat (dest, source: PChar): PChar;
{ same as the Borland Pascal function;
  appends source to dest and returns a pointer
  which points to the modified dest's head.
  dest must be large enough to hold dest+source,
  otherwise you will face a grinding problem. }

FUNCTION StrComp (dest, source: PChar): integer;
{ same as the Borland Pascal function;
  compares dest and source returning 0, if both
  are equal, -1 if dest > source and +1 if dest < source. }

FUNCTION StrCopy (dest, source: PChar): PChar;
{ same as the Borland Pascal function;
  copies source to dest and returns a
  pointer which points to the new copy's head.
  dest must be large enough to contain source,
  otherwise you will face a grinding problem. }

PROCEDURE StrDispose (source: PChar);
{ same as the Borland Pascal function;
  destroys source previously created by StrNew,
  doesn't do anything when passed a NIL pointer. }

FUNCTION StrECopy (dest, source: PChar): PChar;
{ same as the Borland Pascal function;
  copies source to dest and returns a
  pointer which points to the new copy's tail.
  dest must be large enough to contain source,
  otherwise you will face a grinding problem. }

FUNCTION StrEnd (source: PChar): PChar;
{ same as the Borland Pascal function;
  returns a pointer to the end of the source string }

FUNCTION StrLCat (dest, source: PChar; maxlen: byte): PChar;
{ same as the Borland Pascal function;
  appends source to dest for maxlen characters
  and returns a pointer which points to the new
  dest's head;
  dest must be large enough to hold dest plus maxlen
  characters of source, otherwise you will face
  a grinding problem. }

FUNCTION StrLComp (dest, source: PChar; maxlen: byte): integer;
{ same as the Borland Pascal function;
  compares first maxlen characters of dest and source;
  returns 0 if equal, -1 if dest > source and +1 if dest <
  source. }

FUNCTION StrLCopy (dest, source: PChar; maxlen: byte): PChar;
{ same as the Borland Pascal function;
  copies source to dest for maxlen characters,
  returns a pointer which points to the new
  copy's head;
  dest must be large enough to hold maxlen characters,
  otherwise you will face a grinding problem. }

FUNCTION StrLen (source: PChar): word;
{ same as the Borland Pascal function;
  returns the length of the source }

FUNCTION StrLower (source: PChar): PChar;
{ same as the Borland Pascal function;
  converts all characters in source to lower case }

FUNCTION StrMove (dest, source: PChar; maxlen: byte): PChar;
{ same as the Borland Pascal function;
  copies source to dest for maxlen characters,
  returns a pointer which points to the new
  copy's head; dest may overlap source;
  dest must be large enough to hold maxlen characters,
  otherwise you will face a grinding problem. }

FUNCTION StrNew (source: PChar): PChar;
{ same as the Borland Pascal function;
  duplicates source by generating a new copy on the
  heap and returns a pointer which points to the new
  copy. }

FUNCTION StrNSkip (source: PChar; positions: integer): PChar;
{ internal supporting function, which probably may also
  be useful within your own sources; will advance the initial
  pointer in source by positions characters }

FUNCTION StrPas (source: PChar): string;
{ converts a C-string into Turbo Pascal format;
  source string may consist of up to 255 characters,
  otherwise it will be truncated }

FUNCTION StrPCopy (dest: PChar; source: string): PChar;
{ converts a Turbo Pascal string into C format;
  StrPCopy generates a new copy on the heap and will
  return a pointer to that new copy }

FUNCTION StrPos (teststr, substr: PChar): PChar;
{ same as the Borland Pascal function;
  searches teststr for substr, if substr can be found
  returns a pointer to substr's position, else
  returns NIL. }

FUNCTION StrRScan (source: PChar; ch: char): PChar;
{ same as the Borland Pascal function;
  searches source for the _last_ occurrence of ch; if
  ch can be found it returns a pointer to ch,
  otherwise it returns NIL }

FUNCTION StrScan (source: PChar; ch: char): PChar;
{ same as the Borland Pascal function;
  searches source for the first occurrence of ch; if
  ch can be found it returns a pointer to ch,
  otherwise it returns NIL }

FUNCTION StrSkip (source: PChar): PChar;
{ internal supporting function, which probably may also
  be useful within your own sources; will set the
  initial pointer to the source's end (after the
  terminating NUL) }

FUNCTION StrUpper (source: PChar): PChar;
{ same as the Borland Pascal function;
  converts all characters in source to upper case }


IMPLEMENTATION


CONST
  nullstring: char {chArray} = (#0);


FUNCTION LowCase (InChar: char): char;
 BEGIN (* LowCase *)
   IF ('A' <= InChar) AND (InChar <= 'Z')
     THEN LowCase:= chr (ord (InChar)- ord ('A')+ ord ('a'))
     ELSE
       CASE InChar OF
         'Ä': LowCase:= 'ä';
         'Ö': LowCase:= 'ö';
         'Ü': LowCase:= 'ü';
         ELSE LowCase:= InChar;
       END (* CASE InChar *);
 END (* LowCase *);


{$L Fchars }

{ -------------------------------------------------------------------------- }

FUNCTION null_string: PChar;
 BEGIN (* null_string *)
   null_string:= @nullstring;
 END  (* null_string *);


FUNCTION Str2PChar (str: string): PChar; EXTERNAL;

(* Too dangerous to use...

Function Str2PChar(str: string): PChar; assembler;
{ Original author: Andrew Eigus }
Asm
  LES DI,Str
  MOV AL,BYTE PTR [ES:DI]
  CMP AL,0
  JE  @@1
  PUSH DI
  XOR AH,AH
  CLD
  INC AL
  STOSB
  ADD DI,AX
  DEC DI
  XOR AL,AL  { MOV AL,0 }
  STOSB
  POP DI
@@1:
  INC DI
  MOV DX,ES
  MOV AX,DI
End; { Pas2PChar }
 *)
{ -------------------------------------------------------------------------- }

FUNCTION StrCat (dest, source: PChar): PChar; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

FUNCTION StrComp (dest, source: PChar): integer; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

FUNCTION StrCopy (dest, source: PChar): PChar; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

PROCEDURE StrDispose (source: PChar);
{ Original author: Sieghard Schicktanz }
 VAR
   size: word;
 BEGIN (* StrDispose *)
   IF source <> NIL THEN BEGIN
     size:= StrLen (source);
     FreeMem (source, succ (size));
   END (* IF source <> NIL *)
 END (* StrDispose *);

{ -------------------------------------------------------------------------- }

FUNCTION StrECopy (dest, source: PChar): PChar; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

FUNCTION StrEnd (source: PChar): PChar; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

FUNCTION StrLCat (dest, source: PChar; maxlen: byte): PChar; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

FUNCTION StrLComp (dest, source: PChar; maxlen: byte): integer; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

FUNCTION StrLCopy (dest, source: PChar; maxlen: byte): PChar; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

FUNCTION StrLen (source: PChar): word; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

FUNCTION StrLower (source: PChar): PChar;
{ Original author: Sieghard Schicktanz }
 VAR
   i: word;
 BEGIN (* StrLower *)
   StrLower:= source; i:= 0;
   {$V-}
   WHILE source^ [i] <> #0 DO BEGIN
     source^ [i]:= LowCase (source^ [i]); Inc (i);
   END (* WHILE source^ [i] <> #0 *);
   {$V+}
 END (* StrLower *);

{ -------------------------------------------------------------------------- }

FUNCTION StrMove (dest, source: PChar; maxlen: byte): PChar;
{ Original author: Sieghard Schicktanz }
 VAR
   size: word;
 BEGIN (* StrMove *)
   size:= StrLen (source);
   IF (source <> NIL) AND (size <> 0)
     THEN Move (source, dest, succ (size));
   StrMove:= dest;
 END (* StrMove *);

{ -------------------------------------------------------------------------- }

FUNCTION StrNew (source: PChar): PChar;
{ Original author: Sieghard Schicktanz }
 VAR
   size: word;
   dest: PChar;
 BEGIN (* StrNew *)
   size:= StrLen (source);
   IF (source <> NIL) AND (size <> 0) THEN BEGIN
     GetMem (dest, succ (size));
     StrNew:= StrCopy (dest, source);
   END (* IF (source <> NIL) AND (size <> 0) *)
   ELSE StrNew:= NIL;
 END (* StrNew *);

{ -------------------------------------------------------------------------- }

FUNCTION StrNSkip (source: PChar; positions: integer): PChar;
{ Original author: Sieghard Schicktanz }
 BEGIN (* StrNSkip *)
   StrNSkip:= Ptr (Seg (source^), Ofs (source^)+ positions);
 END (* StrNSkip *);

{ -------------------------------------------------------------------------- }

FUNCTION StrPas (source: PChar): string; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

FUNCTION StrPCopy (dest: PChar; source: string): PChar; { EXTERNAL; }
{ Original author: Sieghard Schicktanz }
 BEGIN (* StrPCopy *)
   GetMem (dest, Length (source)+ 1);
   Move (source [1], dest^, Length (source));
   {$V-} dest^ [Length (source)]:= #0; {$V+}
   StrPCopy:= dest;
 END (* StrPCopy *);

{ -------------------------------------------------------------------------- }

FUNCTION StrPos (teststr, substr: PChar): PChar;
{ Original author: Sieghard Schicktanz }
 VAR
   temp: PChar;
 BEGIN (* StrPos *)
   temp:= StrNSkip (teststr, -1);
   REPEAT
     temp:= StrScan (StrNSkip (temp, 1), substr^ [0]);
   UNTIL (temp = NIL) OR (StrComp (temp, substr) <= 0);
   StrPos:= temp;
 END (* StrPos *);

{ -------------------------------------------------------------------------- }

FUNCTION StrRScan (source: PChar; ch: char): PChar; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

FUNCTION StrScan (source: PChar; ch: char): PChar; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

FUNCTION StrSkip (source: PChar): PChar; EXTERNAL;
{ Original author: Sieghard Schicktanz }

{ -------------------------------------------------------------------------- }

FUNCTION StrUpper (source: PChar): PChar;
{ Original author: Sieghard Schicktanz }
 VAR
   i: word;
 BEGIN (* StrUpper *)
   StrUpper:= source; i:= 0;
   {$V-}
   WHILE source^ [i] <> #0 DO BEGIN
     source^ [i]:= UpCase (source^ [i]); Inc (i);
   END (* WHILE source^ [i] <> #0 *);
   {$V+}
 END (* StrUpper *);

{ -------------------------------------------------------------------------- }

{$IFnDEF Overlays}
(* BEGIN (* Fstrings *)
{$ENDIF}
END (* Fstrings *).